home *** CD-ROM | disk | FTP | other *** search
/ Shareware Super Platinum 8 / Shareware Super Platinum 8.iso / mac / PROGTOOL / LCMS.ZIP;1 / ARP910.COB next >
Encoding:
Text File  |  1994-06-09  |  11.4 KB  |  258 lines
  1.        IDENTIFICATION DIVISION.
  2.        PROGRAM-ID. 'ARP910'.
  3.        AUTHOR. HAROLD HAUSERMAN.
  4.        INSTALLATION. SMYRNA CITY BANK.
  5.        DATE-WRITTEN.   JULY 24, 1989.
  6.        REMARKS.            ACTIVITY CONVERSION PROGRAM.
  7.                    READS THE TRANSACTION FILE AND ADDS THE LATEST
  8.                    CHARGE AND LAST FOUR PAMENTS TO THE CUSTOMER
  9.                    MASTER RECORD.  THE INPUT ACTIVITY FILE IS
  10.                    IN THE OLD FORMAT, AND THE CUSTOMER MASTER
  11.                    FILE IS IN THE NEW (VSAM) FORMAT.
  12.        ENVIRONMENT DIVISION.
  13.        CONFIGURATION SECTION.
  14.        INPUT-OUTPUT SECTION.
  15.        FILE-CONTROL.
  16. 00001      SELECT FILE1            ASSIGN TO TRANFILE.                  ARP910
  17. 00002      SELECT FILE2            ASSIGN TO VSAM-CUSTOMER              ARP910
  18. 00003                              ORGANIZATION IS INDEXED              ARP910
  19. 00004                              ACCESS MODE IS DIRECT                ARP910
  20. 00005                              FILE STATUS IS R2-STATUS             ARP910
  21. 00006                              RECORD KEY IS R2-RECORD-KEY.         ARP910
  22. 00007      SELECT FILE3            ASSIGN TO SYSPRINT.                  ARP910
  23.        DATA DIVISION.
  24.        FILE SECTION.
  25.        FD  FILE1 DATA RECORD IS RECORD1 
  26.            RECORD CONTAINS 35 TO 100 CHARACTERS 
  27.            BLOCK CONTAINS 0 RECORDS 
  28.            LABEL RECORDS ARE STANDARD 
  29.            RECORDING MODE IS V.
  30.        01  RECORD1, PICTURE X(100).
  31.        FD  FILE2 DATA RECORD IS RECORD2 
  32.            RECORD CONTAINS 1066 TO 18826 CHARACTERS.
  33. 000420 01  RECORD2.
  34. 000430     03  R2-RECORD-KEY.
  35. 000440         05 R2-BANK-NBR      PICTURE 999.
  36. 000450          05  R2-MERCHANT-NBR  PICTURE 999.
  37. 000460         05  R2-CUSTOMER-NBR  PICTURE 9999.
  38. 000470           05  R2-CHECK-DIGIT   PICTURE 9.
  39.            03 R2-HEADER-ID         PICTURE X(6).
  40.            03  FILLER               PICTURE X(1043).
  41.            03  R2-TRANSACTION-INDEX PICTURE S999, COMP.
  42.            03  R2-TRANSACTION-ENTRY OCCURS 1 TO 240 TIMES
  43.                  DEPENDING ON R2-TRANSACTION-INDEX.
  44.                05  FILLER, PICTURE X(74).
  45.        FD  FILE3 DATA RECORD IS PRINTLINE
  46.            RECORD CONTAINS 133 CHARACTERS
  47.             BLOCK CONTAINS 20 RECORDS
  48.            LABEL RECORDS ARE STANDARD
  49.            RECORDING MODE IS F.
  50.        01  PRINTLINE, PICTURE X(133).
  51. 00063  WORKING-STORAGE SECTION.
  52. 00065  77  SS1  PICTURE S9(5)  COMP  VALUE ZERO.
  53. 00066  77  SS2  PICTURE S9(5)  COMP  VALUE ZERO.
  54. 00067  77  SS3  PICTURE S9(5)  COMP  VALUE ZERO.
  55. 00068  77  EOF-FLAG            PICTURE X VALUE SPACE.
  56. 000700 01  R2-STATUS, PICTURE XX.
  57. 000710         88  OKAY              VALUE '00'.
  58. 000720         88  END-OF-FILE       VALUE '10'.
  59. 000730         88  NOT-FOUND         VALUE '23'.
  60. 000750 01  BREAK-CONTROL.
  61. 000760     02  BC-MERCHANT-NBR, PICTURE 999.
  62. 000770     02 BC-CUSTOMER-NBR, PICTURE 9999.
  63. 000780     02  BC-CHECK-DIGIT, PICTURE 9.
  64. 000800 01  WORKING-DATE.
  65. 000810     10 WD-CENTURY, PICTURE 99, VALUE 19.
  66. 000820     10  WD-YYMMDD.
  67. 000830       15  WD-YEAR, PICTURE 99.
  68. 000840         15  WD-MONTH, PICTURE 99.
  69. 000850        15  WD-DAY, PICTURE 99.
  70. 000870 01  NUMERIC-CONVERSION-FIELDS.
  71. 000880     03  NCF-1.
  72. 000890         07  NCF-1A, PICTURE XXXX.
  73. 000900           07  NCF-1B, PICTURE S9, COMP-3, VALUE ZERO.
  74. 000910     03  NCF-2 REDEFINES NCF-1.
  75. 000920        07  NCF-2A, PICTURE S9(9), COMP-3.
  76. 000930     03  NCF-3, PICTURE 9(9).
  77. 000940     03  NCF-4 REDEFINES NCF-3.
  78. 000950       04  NCF-4A, PICTURE 999.
  79. 000960         04  NCF-4B, PICTURE 9999.
  80. 000970        04 NCF-4C, PICTURE 9.
  81. 000980          04  FILLER, PICTURE X.
  82. 000990     03  NCF-5, PICTURE 9(9).
  83.    000     03 NCF-6 REDEFINES NCF-5.
  84.    010         06  NCF-6A, PICTURE 9(6).
  85.    020         06 NCF-6B, PICTURE 999.
  86.    040 01  TRAN-INPUT-AREA.
  87.    050     13 TIA-SEG-1, PICTURE X(4).
  88.    060       13  TIA-SEG-2, PICTURE S9(9), COMP-3.
  89.    070     13 FILLER, PICTURE X(15).
  90.    080      13  TIA-AMT, PICTURE S9(5)V99, COMP-3.
  91.    090     13  FILLER, PICTURE X(7).
  92.    100       13  TIA-DESCR, PICTURE X(40).
  93.    120 01  TRANSACTION-RECORD.
  94.    130     02  TR-RECORD-KEY.
  95.    140       05 TR-MERCHANT-NBR                     PICTURE 999.
  96.    150         05  TR-CUSTOMER-NBR                  PICTURE 9999.
  97.    160       05 TR-CHECK-DIGIT                 PICTURE 9.
  98.    170     02  TR-DATE                          PICTURE 9(6).
  99.    180      02 TR-TRAN-CODE                     PICTURE 999.
  100.    190     02  TR-COMMENT,                      PICTURE X(40).
  101.    200     02 TR-AMOUNT                            PICTURE 9(5)V99.
  102.    220 01  TRANSACTION-SEGMENTS.
  103.    230     03  TRANSACTION-SEGMENT, OCCURS 4 TIMES.
  104.    240         05  TS-TRAN-CODE, PICTURE XXX.
  105.    250         05 TS-POST-DATE.
  106.    260              09  TSPD-CENTURY, PICTURE 99.
  107.    270             09  TSPD-YEAR, PICTURE 99.
  108.    280              09  TSPD-MONTH, PICTURE 99.
  109.    290             09 TSPD-DAY, PICTURE 99.
  110.    300         05  TS-EFFECTIVE-DATE.
  111.    310             07  TSED-CENTURY, PICTURE 99.
  112.    320             07  TSED-YEAR, PICTURE 99.
  113.    330             07  TSED-MONTH, PICTURE 99.
  114.    340             07  TSED-DAY, PICTURE 99.
  115.    350         05  TS-AMOUNT, PICTURE S9(7)V99, COMP-3.
  116.    360         05  TS-DESCR, PICTURE X(50).
  117.    380 01  CHARGE-SEGMENT.
  118.    390     03  CS-TRAN-CODE, PICTURE XXX.
  119.    400     03  CS-POST-DATE, PICTURE X(8).
  120.    410     03  CS-EFFECTIVE-DATE, PICTURE X(8).
  121.    420     03  CS-AMOUNT, PICTURE S9(7)V99, COMP-3.
  122.    430     03  CS-DESCR, PICTURE X(50).
  123.    450 01  MESSAGE1.
  124.    460     03  FILLER, PICTURE X, VALUE SPACE.
  125.    470     03  M1-BANK-NBR, PICTURE XXX, VALUE '000'.
  126.    480     03  FILLER, PICTURE X, VALUE '-'.
  127.    490     03  M1-MERCHANT-NBR, PICTURE 999.
  128.    500     03  FILLER, PICTURE X, VALUE '-'
  129.    510     03  M1-CUSTOMER-NBR, PICTURE 9999.
  130.    520     03  FILLER, PICTURE X, VALUE '-'.
  131.    530     03  M1-CHECK-DIGIT, PICTURE 9.
  132.    540     03  FILLER, PICTURE XX, VALUE SPACES.
  133.    550     03  M1-MSG-AREA, PICTURE X(40), VALUE SPACES.
  134.    580     COPY ARF020.
  135.    610*************************************************************
  136.    620*    M A I N   L I N E   C O N T R O L   R O U T I N E S    *
  137.    630*************************************************************
  138.    650 PROCEDURE DIVISION.
  139.    670 HOUSEKEEPING-ROUTINE.
  140.    680     MOVE SPACES TO TRAN-INPUT-AREA.
  141.    690     OPEN INPUT FILE1.
  142.    700     OPEN I-O FILE2.
  143.    710     IF R2-STATUS-CODE IS OKAY, NEXT SENTENCE,
  144.    720     ELSE GO TO ERROR-4.
  145.    730     OPEN OUTPUT FILE3.
  146.    740     READ FILE1 INTO TRAN-INPUT-AREA, AT END GO TO ERROR-1.
  147.    750     PERFORM BUILD-TRANSACTION-RECORD.
  148.    760     GO TO A2.
  149.    780 INPUT-CONTROL-ROUTINE.
  150.    790 A1. READ FILE1 INTO TRAN-INPUT-AREA, AT END GO TO B1.
  151.    800     PERFORM BUILD-TRANSACTION-RECORD.
  152.    810     IF TR-RECORD-KEY = BREAK-CONTROL GO TO A3.
  153.    830 CONTROL-BREAK-ROUTINE.
  154.    840     MOVE ZEROS TO R2-BANK-NBR,
  155.    850       MOVE BC-MERCHANT-NBR TO R2-MERCHANT-NBR,
  156.    860         MOVE BC-CUSTOMER-NBR TO R2-CUSTOMER-NBR,
  157.    870           MOVE BC-CHECK-DIGIT TO R2-CHECK-DIGIT.
  158.    880     READ FILE2 INTO CUSTOMER-RECORD.
  159.    890     IF R2-STATUS IS OKAY, NEXT SENTENCE,
  160.    900       ELSE GO TO ERROR-2.
  161.    910     PERFORM UPDATE-CUSTOMER-RECORD THRU T3.
  162.    920     REWRITE RECORD2 FROM CUSTOMER-RECORD.
  163.    930     IF R2-STATUS IS OKAY, NEXT SENTENCE,
  164.    940       ELSE GO TO ERROR-3.
  165.    950 A2. MOVE SPACES TO TRANSACTION-SEGMENTS, CHARGE-SEGMENT.
  166.    960     MOVE TR-RECORD-KEY TO BREAK-CONTROL.
  167.    970     IF EOF-FLAG = 'X' GO TO B2.
  168.    990 EXTRACT-PAYMENTS-ADJUSTMENTS.
  169. 002000 A3. MOVE TR-DATE TO WD-YYMMDD.
  170. 002010     IF TR-TRAN-CODE = 950 GO TO A5.
  171. 002020     IF TR-TRAN-CODE = 970 GO TO A4.
  172. 002030     IF TR-TRAN-CODE = 973 GO TO A4.
  173. 002040     IF TR-TRAN-CODE = 975 GO TO A4, ELSE GO TO A1.
  174. 002050 A4. PERFORM SHIFT-TRANSACTION-SEGMENTS.
  175. 002060     MOVE WORKING-DATE TO TS-POST-DATE (4).
  176. 002070     MOVE WORKING-DATE TO TS-EFFECTIVE-DATE (4).
  177. 002080     MOVE TR-AMOUNT TO TS-AMOUNT.
  178. 002090     IF TR-TRAN-CODE = 970 MOVE '740' TO TS-TRAN-CODE (4),
  179. 002100     ELSE IF TR-TRAN-CODE = 973 MOVE '770' TO TS-TRAN-CODE (4),
  180. 002110     ELSE MOVE '790' TO TS-TRAN-CODE (4).
  181. 002120     MOVE TR-COMMENT TO TS-DESCR (4), GO TO A1.
  182. 002140 EXTRACT-CHARGE-TRANSACTION.
  183. 002150 A5. MOVE '640' TO CS-TRAN-CODE.
  184. 002160     MOVE WORKING-DATE TO CS-POST-DATE, CS-EFFECTIVE-DATE.
  185. 002170     MOVE TR-AMOUNT TO CS-AMOUNT.
  186. 002180     MOVE TR-COMMENT TO CS-DESCR.
  187. 002190     GO TO A1.
  188. 002210 END-OF-JOB-ROUTINE.
  189. 002220 B1. CLOSE FILE1.
  190. 002230     MOVE 'X' TO EOF-FLAG, GO TO CONTROL-BREAK-ROUTINE.
  191. 002240 B2. CLOSE FILE2, FILE3.
  192. 002250     STOP RUN.
  193. 002280*************************************
  194. 002290*    E R R O R   R O U T I N E S    *
  195. 002300*************************************
  196. 002320 ERROR-1.
  197. 002330     MOVE ' INPUT TRANSACTIONS FILE CONTAINS NO DATA'
  198. 002340     TO PRINTLINE.
  199. 002350     WRITE PRINTLINE, GO TO B2.
  200. 002370 ERROR-2.
  201. 002380     PERFORM LOAD-MESSAGE-HEADER.
  202. 002390     MOVE ' CUSTOMER RECORD NOT FOUND ' TO M1-MSG-AREA.
  203. 002400     WRITE PRINTLINE FROM MESSAGE1.
  204. 002410     GO TO A2.
  205. 002430 ERROR-3.
  206. 002440     PERFORM LOAD-MESSAGE-HEADER.
  207. 002450     MOVE ' CANNOT REWRITE CUSTOMER RECORD' TO M1-MSG-AREA.
  208. 002460     WRITE PRINTLINE FROM MESSAGE1.
  209. 002470     GO TO A2.
  210. 002490 ERROR-4.
  211. 002500     MOVE ' CANNOT OPEN CUSTOMER FILE' TO PRINTLINE.
  212. 002510     WRITE PRINTLINE.
  213. 002520     MOVE ' PROGRAM ABORTING' TO PRINTLINE.
  214. 002530     WRITE PRINTLINE.
  215. 002540     STOP RUN.
  216. 002570***************************************************
  217. 002580*    P E R F O R M E D   S U B R O U T I N E S    *
  218. 002590***************************************************
  219. 002610 LOAD-MESSAGE-HEADER.
  220. 002620     MOVE BC-MERCHANT-NBR TO M1-MERCHANT-NBR.
  221. 002630     MOVE BC-CUSTOMER-NBR TO M1-CUSTOMER-NBR.
  222. 002640     MOVE BC-CHECK-DIGIT TO M1-CHECK-DIGIT.
  223. 002660 SHIFT-TRANSACTION-SEGMENTS.
  224. 002670     MOVE TRANSACTION-SEGMENT (2)
  225. 002680     TO TRANSACTION-SEGMENT (1).
  226. 002690     MOVE TRANSACTION-SEGMENT (3)
  227. 002700     TO TRANSACTION-SEGMENT (2).
  228. 002710     MOVE TRANSACTION-SEGMENT (4)
  229. 002720     TO TRANSACTION-SEGMENT (3).
  230. 002730     MOVE SPACES TO TRANSACTION-SEGMENT (4).
  231.        BUILD-TRANSACTION-RECORD.
  232.            MOVE TIA-SEG-1              TO NCF-1A,
  233.            MOVE NCF-21                 TO NCF-3.
  234.            MOVE NCF-4A                 TO TR-MERCHANT-NBR.
  235.            MOVE NCF-4B                 TO TR-CUSTOMER-NBR.
  236.            MOVE NCF-4C                 TO TR-CHECK-DIGIT.
  237.            MOVE TIA-SEG-2              TO NCF-5. 
  238.            MOVE NCF-6A                 TO TR-DATE.
  239.            MOVE NCF-6B                 TO TR-TRAN-CODE.
  240.            MOVE TIA-AMT                TO TR-AMOUNT.
  241.            MOVE TIA-DESCR              TO TR-COMMENT.
  242.            MOVE SPACES                 TO TRAN-INPUT-AREA.
  243.  00070 UPDATE-CUSTOMER-RECORD.
  244.  00080     IF CS-TRAN=CODE = SPACES GO TO S1.
  245.  00090     MOVE CHARGE-SEGMENT TO MONETARY-TRANSACTION-TABLE (1).
  246. 031000     MOVE +1 TO MONETARY-TRANSACTION-NBR-OCCURS.
  247. 031010     MOVE +2 TO SS2, GO TO S2.
  248. 031020 S1. MOVE +1 TO SS2.
  249. 031030 S2. MOVE +1 TO SS1, GO TO T2.
  250. 031040 T1. ADD +1 TO SS1.
  251.            IF SS1 IS GREATER THAN +4 GO TO T3.
  252.        T2. IF TS-TRANCODE (SS1) = SPACES GO TO T1.
  253. 031070     MOVE TRANSACTION-SEGMENT (SS1)
  254. 031080     TO MONETARY-TRANSACTION-TABLE (SS2).
  255. 031090     MOVE SS2 TO MONETARY-TRANSACTION-NBR-OCCURS.
  256. 003000     ADD +1 TO SS2, GO TO T1.
  257. 003010 T3. EXIT.
  258.